home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
forge20.zip
/
EXTPROC3.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-01-04
|
5KB
|
192 lines
Procedure Review_Next_Rec;
Begin
Blank_Fields;
If Not EOF(Output_File) Then Begin
Current_File_Pos:= Current_File_Pos+1;
Read_Record_and_Write_It;
End
Else Begin {it is EOF}
Sound(1000);
Delay(200);
Nosound;
Current_File_Pos:= FileSize(Output_File)+1;
Write_Init_Val;
End;
Write_Recno;
End; { procedure review_next_rec }
Procedure Goto_RecNo;
Var
Key: Char;
Goto_File_Pos: String[6];
Begin
TextBackground(LightGray);
TextColor(Black);
GotoXY(41,25);
Write(' ');
GotoXY(41,25);
Repeat
Repeat
Read(Kbd, Key);
Until Key <> Chr(0);
If Key in ['0'..'9'] Then Begin
Goto_File_Pos:= Goto_File_Pos + Key;
Write(Key);
End;
Until Key = Chr(13);
Val(Goto_File_Pos, Current_File_Pos, ErrorPos);
If ErrorPos = 0 Then Begin
If ((Current_File_Pos > 0)
and not (Current_File_Pos > FileSize(Output_File))) Then Begin
Read_Record_and_Write_It;
Write_RecNo;
End
Else Begin {current_file_pos is > filesize}
Sound(5000);
Delay(150);
NoSound;
Current_File_Pos:= FileSize(Output_File);
Read_Record_and_Write_It;
Write_RecNo;
End;
End { if errorpos = 0 }
Else Goto_RecNo;
End; { procedure goto_recno }
Procedure Write_To_Output_File;
Begin
Seek(Output_File,Current_File_Pos-1);
Write(Output_File,Output_Record);
If not EOF(Output_File) Then Begin
Banner_Line;
Review_Next_Rec;
End
Else Begin {it is EOF}
Current_File_Pos:= FilePos(Output_File)+1;
Banner_Line;
Write_Recno;
End;
End; { procedure write_to_output_file }
Procedure Delete_Rec;
Begin
If Output_Record.Delete <> 'X' Then
Output_Record.Delete:= 'X'
Else Output_Record.Delete:= ' ';
Write_To_Output_File;
End;
Procedure BackUp;
Var
EXISTS: Boolean;
Begin
Close(Output_File);
i:= 1;
BackUp_File_Name:= '';
While ((i < 9) and not (Copy(File_Name,i,1) = '.')) Do Begin
BackUp_File_Name:= BackUp_File_Name + Copy(File_Name,i,1);
i:= i+1;
End;
BackUp_File_Name:= BackUp_File_Name + '.bak';
If NOT (Backup_File_Name = File_Name) Then Begin
Assign(Old_File, Backup_File_Name); { purge the oldest .bak file }
{$I-} Erase(Old_File) {$I+}; EXISTS:= (IOresult = 0); { force continuation }
Assign(Old_File, File_Name); { orig. file becomes .bak file }
Rename(Old_File, Backup_File_Name);
Assign(New_OutPut_File, File_Name); { new file gets the orig. name }
Rewrite(New_OutPut_File);
Reset(Old_File);
While not EOF(Old_File) Do Begin
Read(Old_File, Output_Record); { copy all records except the }
If Output_Record.Delete <> 'X'Then { deleted ones from the .bak }
Write(New_Output_File, Output_Record); { file to the new file }
End;
Close (New_Output_File);
Close (Old_File);
Assign(Output_File, File_Name);
Reset(Output_File);
Current_File_Pos:= FileSize(Output_File);
Blank_Fields;
Read_Record_and_Write_It;
Write_RecNo;
End {if back_up_name <> file_name}
Else Begin {back_up_name does = file_name}
Sound (1000);
Delay (200);
NoSound;
GotoXY (2,25); TextColor(Black);
TextBackGround(LightGray);
For i:= 1 to 65 Do Write (Chr(32));
GotoXY (2,25);
Write ('Cannot Backup ".bak" Files');
End; {back_up_name does = file_name}
End; { procedure backup }
Procedure ReadKbd;
Var
Key1, Key :Char;
X1, X2 :Byte;
Begin
Repeat
X1:= 0;
X2:= 0;
Repeat
Read(Kbd,Key1);
Until Key1 <> Chr(0);
X1:= Ord(Key1);
Key1:= Chr(X1);
Case X1 of
27: Begin
Read(Kbd,Key);
X2:= Ord(Key);
Case X2 of
59: Done_Adding:= True; {f1}
60: Review_Prev_Rec; {f2}
61: Review_Next_Rec; {f3}
62: Delete_Rec; {f4}
63: Goto_RecNo; {f5}
66: BackUp; {f8}
77: RT1; {rt arrow}
75: LT1; {lt arrow}
{83: Left_Shift_Buffer;} { del key }
End;
End;
Else If Key1 = Chr(8) Then {bs key}
Begin
LT1;
{ Left_Shift_Buffer; }
End
Else If ((Key1 = Chr(9)) or (Key1 = Chr(13))) Then {tab or ret key}
Tab
Else Begin
Write(Key1);
ScrBuf[XY]:= Key1;
Rt1;
End;
End;
Until ((Key = Chr(68)) or (Key = Chr(59))); { f0 or f1 key }
Output_Record.Delete:= Chr(32);
Output_Record.CR:= Chr(13);
Done_Reading_Kbd:= True;
End; { procedure readkbd }